Sooooo nothing with BEC zones has been promising so far. Let’s try something else. Let’s switch to VRI data and see if amount of mature/old growth forest is related to amount of squirrel in the diet, since squirrels like old forests.

# Load some libraries.
library(tidyverse)
library(landscapemetrics)
library(raster)
library(sf)
# Bring in diet data.
df <- read_csv('../data/interim/camera_corrected.csv', guess_max=7000)
# I had some trouble with readr so I increased the number of rows used to guess.
source('../src/prey_attributes.R')
head(items)
# Calculate proportion of diet made up of squirrel at each site.
sq.mass <- items %>% mutate(mass=as.numeric(mass)) %>% 
  group_by(site) %>% 
  mutate(total=sum(mass)) %>% 
  filter(genus == 'Tamiasciurus') %>% 
  mutate(amount.sq=sum(mass), prop.sq=amount.sq/total) %>% 
  dplyr::select(site, prop.sq) %>% distinct()
sq.mass

That’s remarkably consistent.

The next step is to get the amount of mature forest for each of these sites. Unfortunately, the VRI data for Turbid Creek is useless so that drops me down to five sites. But I can pull in the VRI for the others…

# Import transition zone shapefile.
vri <- st_read('../data/external/VRI_camera-sites_2019.shp')
Reading layer `VRI_camera-sites_2019' from data source `C:\Users\Gwyn\sfuvault\productivity-occupancy\data\external\VRI_camera-sites_2019.shp' using driver `ESRI Shapefile'
Simple feature collection with 13321 features and 188 fields
geometry type:  POLYGON
dimension:      XY
bbox:           xmin: 413289.1 ymin: 5428268 xmax: 645675.7 ymax: 5589928
CRS:            32610

Then I need to rasterize it. Which means first I need to break it down into classes so I can assign a raster value. Unfortunately there’s no single field in the VRI data that works for classification. I can break this into:

# Assign to classes.
# Regen/young/mature/old ages come from Zharikov et al. 2007
vri.class <- vri %>% mutate(hab.class=case_when(
  # Non-vegetated and water
  BCLCS_LV_1 == 'N' & BCLCS_LV_2 == 'W' ~ 1, 
  # Non-vegetated and not water
  BCLCS_LV_1 == 'N' & BCLCS_LV_2 != 'W' ~ 2, 
  # Vegetated and not trees
  BCLCS_LV_1 == 'V' & BCLCS_LV_2 == 'N' ~ 3,
  # Vegetated and mixed or deciduous trees
  BCLCS_LV_1 == 'V' & BCLCS_LV_4 %in% c('TB', 'TM') ~ 4,
  # Vegetated and coniferous trees
  BCLCS_LV_4 == 'TC' & PROJ_AGE_1 < 20 ~ 5,
  BCLCS_LV_4 == 'TC' & PROJ_AGE_1 >= 20 & PROJ_AGE_1 < 60 ~ 6,
  BCLCS_LV_4 == 'TC' & PROJ_AGE_1 >= 60 & PROJ_AGE_1 < 140 ~ 7,
  BCLCS_LV_4 == 'TC' & PROJ_AGE_1 >= 140 ~ 8,
  TRUE ~ 0
))
# See how it turned out.
vri.class %>% group_by(hab.class) %>% summarise(n())
Simple feature collection with 9 features and 2 fields
geometry type:  MULTIPOLYGON
dimension:      XY
bbox:           xmin: 413289.1 ymin: 5428268 xmax: 645675.7 ymax: 5589928
CRS:            32610

A little investigating shows that the 4 polygons classed as 0 are unclassified in the VRI or conifer polygons with unknown ages, so that seems fine.

# Set raster extent based on tz shapefile.
ext <- extent(vri)

# Make an empty raster to populate with values.
r <- raster(ext, res=c(100, 100))

# Populate BEC polygon data onto empty raster grid.
r.vri <- rasterize(vri.class, r, 'hab.class')

# Create labels for raster.
vri.levels <- data.frame(ID=0:8, class.name=c('undefined', 'water', 'land', 'unforested', 'deciduous', 'regen', 'young', 'mature', 'old'))

# Add them to the raster.
levels(r.vri) <- vri.levels

# Save the raster image.
writeRaster(r.vri, '../data/interim/vri_camera-sites_2019.tif', format='GTiff')

If picking up later, load up the raster and keep going.

# Import the raster.
r.vri <- raster('../data/interim/vri_camera-sites_2019.tif')

# Import nests and calculate centroids.
sites <- read_csv('../data/processed/the_big_list_of_nests.csv') %>% 
  group_by(name) %>% 
  mutate_at(c('lat', 'lon'), mean) %>% 
  mutate_at(vars(starts_with('status')), max) %>% 
  mutate_at(c('telemetry', 'cameras', 'remains'), max) %>% 
  dplyr::select(-nest, -NOTES) %>% 
  distinct() %>% 
  filter(cameras > 0)
LS0tDQp0aXRsZTogIkVkZ2Ugc3BlY2llcyINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KLS0tDQoNCmBgYHtyIHNldHVwLCBpbmNsdWRlPUZBTFNFfQ0Ka25pdHI6Om9wdHNfY2h1bmskc2V0KGVjaG89VFJVRSwgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRSkNCmBgYA0KDQpTb29vb28gbm90aGluZyB3aXRoIEJFQyB6b25lcyBoYXMgYmVlbiBwcm9taXNpbmcgc28gZmFyLiBMZXQncyB0cnkgc29tZXRoaW5nIGVsc2UuIExldCdzIHN3aXRjaCB0byBWUkkgZGF0YSBhbmQgc2VlIGlmIGFtb3VudCBvZiBtYXR1cmUvb2xkIGdyb3d0aCBmb3Jlc3QgaXMgcmVsYXRlZCB0byBhbW91bnQgb2Ygc3F1aXJyZWwgaW4gdGhlIGRpZXQsIHNpbmNlIHNxdWlycmVscyBsaWtlIG9sZCBmb3Jlc3RzLg0KDQpgYGB7cn0NCiMgTG9hZCBzb21lIGxpYnJhcmllcy4NCmxpYnJhcnkodGlkeXZlcnNlKQ0KbGlicmFyeShsYW5kc2NhcGVtZXRyaWNzKQ0KbGlicmFyeShyYXN0ZXIpDQpsaWJyYXJ5KHNmKQ0KDQojIEJyaW5nIGluIGRpZXQgZGF0YS4NCmRmIDwtIHJlYWRfY3N2KCcuLi9kYXRhL2ludGVyaW0vY2FtZXJhX2NvcnJlY3RlZC5jc3YnLCBndWVzc19tYXg9NzAwMCkNCiMgSSBoYWQgc29tZSB0cm91YmxlIHdpdGggcmVhZHIgc28gSSBpbmNyZWFzZWQgdGhlIG51bWJlciBvZiByb3dzIHVzZWQgdG8gZ3Vlc3MuDQoNCnNvdXJjZSgnLi4vc3JjL3ByZXlfYXR0cmlidXRlcy5SJykNCg0KaGVhZChpdGVtcykNCg0KIyBDYWxjdWxhdGUgcHJvcG9ydGlvbiBvZiBkaWV0IG1hZGUgdXAgb2Ygc3F1aXJyZWwgYXQgZWFjaCBzaXRlLg0Kc3EubWFzcyA8LSBpdGVtcyAlPiUgbXV0YXRlKG1hc3M9YXMubnVtZXJpYyhtYXNzKSkgJT4lIA0KICBncm91cF9ieShzaXRlKSAlPiUgDQogIG11dGF0ZSh0b3RhbD1zdW0obWFzcykpICU+JSANCiAgZmlsdGVyKGdlbnVzID09ICdUYW1pYXNjaXVydXMnKSAlPiUgDQogIG11dGF0ZShhbW91bnQuc3E9c3VtKG1hc3MpLCBwcm9wLnNxPWFtb3VudC5zcS90b3RhbCkgJT4lIA0KICBkcGx5cjo6c2VsZWN0KHNpdGUsIHByb3Auc3EpICU+JSBkaXN0aW5jdCgpDQoNCnNxLm1hc3MNCmBgYA0KDQpUaGF0J3MgcmVtYXJrYWJseSBjb25zaXN0ZW50Lg0KDQpUaGUgbmV4dCBzdGVwIGlzIHRvIGdldCB0aGUgYW1vdW50IG9mIG1hdHVyZSBmb3Jlc3QgZm9yIGVhY2ggb2YgdGhlc2Ugc2l0ZXMuIFVuZm9ydHVuYXRlbHksIHRoZSBWUkkgZGF0YSBmb3IgVHVyYmlkIENyZWVrIGlzIHVzZWxlc3Mgc28gdGhhdCBkcm9wcyBtZSBkb3duIHRvIGZpdmUgc2l0ZXMuIEJ1dCBJIGNhbiBwdWxsIGluIHRoZSBWUkkgZm9yIHRoZSBvdGhlcnMuLi4NCg0KYGBge3J9DQojIEltcG9ydCB0cmFuc2l0aW9uIHpvbmUgc2hhcGVmaWxlLg0KdnJpIDwtIHN0X3JlYWQoJy4uL2RhdGEvZXh0ZXJuYWwvVlJJX2NhbWVyYS1zaXRlc18yMDE5LnNocCcpDQpgYGANCg0KVGhlbiBJIG5lZWQgdG8gcmFzdGVyaXplIGl0LiBXaGljaCBtZWFucyBmaXJzdCBJIG5lZWQgdG8gYnJlYWsgaXQgZG93biBpbnRvIGNsYXNzZXMgc28gSSBjYW4gYXNzaWduIGEgcmFzdGVyIHZhbHVlLiBVbmZvcnR1bmF0ZWx5IHRoZXJlJ3Mgbm8gc2luZ2xlIGZpZWxkIGluIHRoZSBWUkkgZGF0YSB0aGF0IHdvcmtzIGZvciBjbGFzc2lmaWNhdGlvbi4gSSBjYW4gYnJlYWsgdGhpcyBpbnRvOg0KDQoqIFdhdGVyICgxKQ0KKiBMYW5kICh1bnZlZ2V0YXRlZCkgKDIpDQoqIFZlZ2V0YXRlZCAobm90IGZvcmVzdCkgKDMpDQoqIERlY2lkdW91cyAoNCkNCiogQ29uaWZlcm91cyAocmVnZW4sIHlvdW5nLCBtZWRpdW0sIGFuZCBvbGQpICg1LCA2LCA3LCA4KQ0KDQpgYGB7cn0NCiMgQXNzaWduIHRvIGNsYXNzZXMuDQojIFJlZ2VuL3lvdW5nL21hdHVyZS9vbGQgYWdlcyBjb21lIGZyb20gWmhhcmlrb3YgZXQgYWwuIDIwMDcNCnZyaS5jbGFzcyA8LSB2cmkgJT4lIG11dGF0ZShoYWIuY2xhc3M9Y2FzZV93aGVuKA0KICAjIE5vbi12ZWdldGF0ZWQgYW5kIHdhdGVyDQogIEJDTENTX0xWXzEgPT0gJ04nICYgQkNMQ1NfTFZfMiA9PSAnVycgfiAxLCANCiAgIyBOb24tdmVnZXRhdGVkIGFuZCBub3Qgd2F0ZXINCiAgQkNMQ1NfTFZfMSA9PSAnTicgJiBCQ0xDU19MVl8yICE9ICdXJyB+IDIsIA0KICAjIFZlZ2V0YXRlZCBhbmQgbm90IHRyZWVzDQogIEJDTENTX0xWXzEgPT0gJ1YnICYgQkNMQ1NfTFZfMiA9PSAnTicgfiAzLA0KICAjIFZlZ2V0YXRlZCBhbmQgbWl4ZWQgb3IgZGVjaWR1b3VzIHRyZWVzDQogIEJDTENTX0xWXzEgPT0gJ1YnICYgQkNMQ1NfTFZfNCAlaW4lIGMoJ1RCJywgJ1RNJykgfiA0LA0KICAjIFZlZ2V0YXRlZCBhbmQgY29uaWZlcm91cyB0cmVlcw0KICBCQ0xDU19MVl80ID09ICdUQycgJiBQUk9KX0FHRV8xIDwgMjAgfiA1LA0KICBCQ0xDU19MVl80ID09ICdUQycgJiBQUk9KX0FHRV8xID49IDIwICYgUFJPSl9BR0VfMSA8IDYwIH4gNiwNCiAgQkNMQ1NfTFZfNCA9PSAnVEMnICYgUFJPSl9BR0VfMSA+PSA2MCAmIFBST0pfQUdFXzEgPCAxNDAgfiA3LA0KICBCQ0xDU19MVl80ID09ICdUQycgJiBQUk9KX0FHRV8xID49IDE0MCB+IDgsDQogIFRSVUUgfiAwDQopKQ0KDQojIFNlZSBob3cgaXQgdHVybmVkIG91dC4NCnZyaS5jbGFzcyAlPiUgZ3JvdXBfYnkoaGFiLmNsYXNzKSAlPiUgc3VtbWFyaXNlKG4oKSkNCmBgYA0KDQpBIGxpdHRsZSBpbnZlc3RpZ2F0aW5nIHNob3dzIHRoYXQgdGhlIDQgcG9seWdvbnMgY2xhc3NlZCBhcyAwIGFyZSB1bmNsYXNzaWZpZWQgaW4gdGhlIFZSSSBvciBjb25pZmVyIHBvbHlnb25zIHdpdGggdW5rbm93biBhZ2VzLCBzbyB0aGF0IHNlZW1zIGZpbmUuIA0KDQpgYGB7ciBldmFsPUZBTFNFfQ0KIyBTZXQgcmFzdGVyIGV4dGVudCBiYXNlZCBvbiB0eiBzaGFwZWZpbGUuDQpleHQgPC0gZXh0ZW50KHZyaSkNCg0KIyBNYWtlIGFuIGVtcHR5IHJhc3RlciB0byBwb3B1bGF0ZSB3aXRoIHZhbHVlcy4NCnIgPC0gcmFzdGVyKGV4dCwgcmVzPWMoMTAwLCAxMDApKQ0KDQojIFBvcHVsYXRlIEJFQyBwb2x5Z29uIGRhdGEgb250byBlbXB0eSByYXN0ZXIgZ3JpZC4NCnIudnJpIDwtIHJhc3Rlcml6ZSh2cmkuY2xhc3MsIHIsICdoYWIuY2xhc3MnKQ0KDQojIENyZWF0ZSBsYWJlbHMgZm9yIHJhc3Rlci4NCnZyaS5sZXZlbHMgPC0gZGF0YS5mcmFtZShJRD0wOjgsIGNsYXNzLm5hbWU9YygndW5kZWZpbmVkJywgJ3dhdGVyJywgJ2xhbmQnLCAndW5mb3Jlc3RlZCcsICdkZWNpZHVvdXMnLCAncmVnZW4nLCAneW91bmcnLCAnbWF0dXJlJywgJ29sZCcpKQ0KDQojIEFkZCB0aGVtIHRvIHRoZSByYXN0ZXIuDQpsZXZlbHMoci52cmkpIDwtIHZyaS5sZXZlbHMNCg0KIyBTYXZlIHRoZSByYXN0ZXIgaW1hZ2UuDQp3cml0ZVJhc3RlcihyLnZyaSwgJy4uL2RhdGEvaW50ZXJpbS92cmlfY2FtZXJhLXNpdGVzXzIwMTkudGlmJywgZm9ybWF0PSdHVGlmZicpDQpgYGANCg0KSWYgcGlja2luZyB1cCBsYXRlciwgbG9hZCB1cCB0aGUgcmFzdGVyIGFuZCBrZWVwIGdvaW5nLg0KDQpgYGB7cn0NCiMgSW1wb3J0IHRoZSByYXN0ZXIuDQpyLnZyaSA8LSByYXN0ZXIoJy4uL2RhdGEvaW50ZXJpbS92cmlfY2FtZXJhLXNpdGVzXzIwMTkudGlmJykNCg0KIyBJbXBvcnQgbmVzdHMgYW5kIGNhbGN1bGF0ZSBjZW50cm9pZHMuDQpzaXRlcyA8LSByZWFkX2NzdignLi4vZGF0YS9wcm9jZXNzZWQvdGhlX2JpZ19saXN0X29mX25lc3RzLmNzdicpICU+JSANCiAgZ3JvdXBfYnkobmFtZSkgJT4lIA0KICBtdXRhdGVfYXQoYygnbGF0JywgJ2xvbicpLCBtZWFuKSAlPiUgDQogIG11dGF0ZV9hdCh2YXJzKHN0YXJ0c193aXRoKCdzdGF0dXMnKSksIG1heCkgJT4lIA0KICBtdXRhdGVfYXQoYygndGVsZW1ldHJ5JywgJ2NhbWVyYXMnLCAncmVtYWlucycpLCBtYXgpICU+JSANCiAgZHBseXI6OnNlbGVjdCgtbmVzdCwgLU5PVEVTKSAlPiUgDQogIGRpc3RpbmN0KCkgJT4lIA0KICBmaWx0ZXIoY2FtZXJhcyA+IDApDQpgYGA=